VBScript → Lua
This function checks a given date for a public holiday in Germany. It takes the different federal states into consideration.
Please see the Introduction chapter for some usage instructions.
' Federal States of Germany
const vb_FS_BW = 1 ' Baden-Wuerttemberg
const vb_FS_BYMH = 131072 ' Bayern (mit Mariea Himmelfahrt)
const vb_FS_BY = 2 ' Bayern (ohne Mariea Himmelfahrt)
const vb_FS_BE = 4 ' Berlin
const vb_FS_BB = 8 ' Brandenburg
const vb_FS_HB = 16 ' Bremen
const vb_FS_HH = 32 ' Hamburg
const vb_FS_HE = 64 ' Hessen
const vb_FS_MV = 128 ' Mecklenburg-Vorpommern
const vb_FS_NI = 256 ' Niedersachsen
const vb_FS_NW = 512 ' Nordrhein-Westfalen
const vb_FS_RP = 1024 ' Rheinland-Pfalz
const vb_FS_SL = 2048 ' Saarland
const vb_FS_SN = 4096 ' Sachsen
const vb_FS_ST = 8192 ' Sachen-Anhalt
const vb_FS_SH = 16384 ' Schleswig-Holstein
const vb_FS_TH = 32768 ' Thueringen
const vb_FS_KD = 65536 ' Koeln/Duesseldorf (Rosenmontag)
const vb_FS_AU = 262144 ' Augsburg (Friedensfest)
'-------------------------------------------------------------------
' Name: IsPublicHolidayDE
' =================
'
' Returns true if the given date is a public holiday in the given German
' federal state. Multiple federal states can be combined with "OR"
'
' Parameter:
' nFederalState single or combination of federal states
' vCheckDate vbscript date to check (e.g. as returned by now) or
' "" (for current date)
'
' Returns:
' Boolean True = is public holiday
'
'--------------------------------------------------------------------
Function IsPublicHolidayDE ( nFederalState, vCheckDate )
On Error Resume Next
PBXScript.OutputTrace "-------> IsPublicHolidayDE"
PBXScript.OutputTrace "nFederalState = " & nFederalState
PBXScript.OutputTrace "vCheckDate = " & vCheckDate
Dim bReturn
bReturn = False
Dim a, b, c, d, e, f
Dim nTempYear, vTempDate
Dim Neujahr, Erscheinungsfest, Karfreitag, Ostersonntag, Ostermontag
Dim Weltfrauentag, Maifeiertag, Rosenmontag, ChrHimmelfahrt, Pfingstmontag, Fronleichnam
Dim MarieaHimmelfahrt, Friedensfest, Weltkindertag, Tagdereinheit, Reformationstag, Allerheiligen
Dim BussUndBettag, Weihnachten1, Weihnachten2
if not IsDate(vCheckDate) then vCheckDate = Now
vTempDate = DateSerial(Year(vCheckDate), Month(vCheckDate), Day(vCheckDate))
nTempYear = Year(vTempDate)
PBXScript.OutputTrace "Using nTempYear = " & nTempYear
PBXScript.OutputTrace "Using vTempDate = " & vTempDate
' Gauss Formular
a = nTempYear Mod 19
b = nTempYear \ 100
c = (8 * b + 13) \ 25 - 2
d = b - (nTempYear \ 400) - 2
e = (19 * (nTempYear Mod 19) + ((15 - c + d) Mod 30)) Mod 30
if e = 28 then
if a > 10 then
e = 27
end if
elseif e = 29 then
e = 28
end if
f = (d + 6 * e + 2 * (nTempYear Mod 4) + 4 * (nTempYear Mod 7) + 6) Mod 7
' Calculate public holidays
Neujahr = DateSerial(nTempYear, 1, 1)
Erscheinungsfest = DateSerial(nTempYear, 1, 6)
Weltfrauentag = DateSerial(nTempYear, 3, 8)
Ostersonntag = DateSerial(nTempYear, 3, e + f + 22)
Rosenmontag = DateSerial(nTempYear, 3, e + f + 22 - 48)
Karfreitag = DateSerial(nTempYear, 3, e + f + 22 - 2)
Ostermontag = DateSerial(nTempYear, 3, e + f + 22 + 1)
Maifeiertag = DateSerial(nTempYear, 5, 1)
ChrHimmelfahrt = DateSerial(nTempYear, 3, e + f + 22 + 39)
Pfingstmontag = DateSerial(nTempYear, 3, e + f + 22 + 50)
Fronleichnam = DateSerial(nTempYear, 3, e + f + 22 + 60)
Friedensfest = DateSerial(nTempYear, 8, 8)
MarieaHimmelfahrt = DateSerial(nTempYear, 8, 15)
Weltkindertag = DateSerial(nTempYear, 9, 20)
Tagdereinheit = DateSerial(nTempYear, 10, 3)
Reformationstag = DateSerial(nTempYear, 10, 31)
Allerheiligen = DateSerial(nTempYear, 11, 1)
BussUndBettag = DateSerial(nTempYear, 11, 25) - Weekday(DateSerial(nTempYear, 11, 25), vbMonday) - 4 * 7 - vbWednesday
Weihnachten1 = DateSerial(nTempYear, 12, 25)
Weihnachten2 = DateSerial(nTempYear, 12, 26)
' Is public holiday?
select case vTempDate
case Neujahr
bReturn = True
case Erscheinungsfest
if (nFederalState and (vb_FS_BW or vb_FS_BY or vb_FS_BYMH or vb_FS_ST)) then bReturn = True
case Weltfrauentag
if (nFederalState and (vb_FS_BE)) then bReturn = True
case Ostersonntag
bReturn = True
case Rosenmontag
If(nFederalState and (vb_FS_KD)) then bReturn = True
case Karfreitag
bReturn = True
case Ostermontag
bReturn = True
case Maifeiertag
bReturn = True
case ChrHimmelfahrt
bReturn = True
case Pfingstmontag
bReturn = True
case Fronleichnam
if (nFederalState and (vb_FS_BW or vb_FS_BY or vb_FS_BYMH or vb_FS_HE or vb_FS_NW or vb_FS_RP or vb_FS_SL)) then bReturn = True
case Friedensfest
If(nFederalState and (vb_FS_AU)) then bReturn = True
case MarieaHimmelfahrt
if (nFederalState and (vb_FS_BYMH or vb_FS_SL)) then bReturn = True
case Weltkindertag
if (nFederalState and (vb_FS_TH)) then bReturn = True
case Tagdereinheit
bReturn = True
case Reformationstag
if (nFederalState and (vb_FS_BB or vb_FS_HB or vb_FS_HH or vb_FS_MV or vb_FS_NI or vb_FS_SN or vb_FS_ST or vb_FS_SH or vb_FS_TH)) then bReturn = True
case Allerheiligen
if (nFederalState and (vb_FS_BW or vb_FS_BY or vb_FS_BYMH or vb_FS_NW or vb_FS_RP or vb_FS_SL)) then bReturn = True
case BussUndBettag
if (nFederalState and (vb_FS_SN)) then bReturn = True
case Weihnachten1
bReturn = True
case Weihnachten2
bReturn = True
end select
IsPublicHolidayDE = bReturn
PBXScript.OutputTrace "bReturn = " & bReturn
PBXScript.OutputTrace "<------- IsPublicHolidayDE"
End Function
The first parameter of the function is either one or a list federal states (linked by OR). See the above code for the possible values for each federal state.
The second parameter is the date to check. This can either be a VBScript variant type (like e.g. Now returns or have been loaded from a database field of type datetime) or a string representing the date to be checked. Please note that in this case the string must be a valid date according the the regional settings configuration of your server machine (in regard to is format).
Examples
-
Check in Nordrhein-Westfalen for current date:
IsPublicHolidayDE(vb_FS_NW, "")
IsPublicHolidayDE(vb_FS_NW, Now)
-
Check in Bayern and Saarland for a given fixed date:
IsPublicHolidayDE(vb_FS_BY or vb_FS_SL, "01.05.2015")
This function was provided by the well known forum user JoergG.
This function was initially posted into this forum topic.
By Tom Wellige
